Projekt ZED
Aleksander Lisiecki
11 grudzień 2021
Executive summary
Celem analizy jest interpretacja danych finansowych ceclem znalezienia wzorców wpływających na ceny różnych aktyw oraz wykonanie modelu potrafiącego zwrócić korzystne informacje dotyczące ceny złota.
Wśród danych znalazły się:
- kurs złota,
- wskaźniki rozwoju gospodarczego świata,
- dane dotyczące indeksu S&P Composite,
- kurs wymiany walut,
- dane z blockchainu Bitcoina,
- subiektywnie wyznaczone dobre momenty na kupno i sprzedaż złota.
W celu znalezienia możliwych korelacji w zbiorach dane zostały porównane ze sobą oraz sprawdzona została ich korelacja. W analizie zawarte zostały:
- wizualizacja zmiany ludności w najliczniejszych krajach świata,
- ukazany został trend dotyczący samobójstw na świecie,
- zależność ceny złota do ceny Bitcoina,
- zależność ceny złota do ceny indeksu S&P Composite,
- 15 największych korelacji pomiędzy wskaźnikami największej gospodarki świata - USA, a ceną złota,
W sekcji poświęconej próbie predykcji korzystnych informacji dotyczących ceny złota stworzony został klasyfikator próbujący przewidzieć dobry moment na kupno i sprzedaż kruszcu.
Errata: Błędy z ggplotly:
- w wynikowym HTML’u nie wyświetla się wykres samobójstw - w arkuszu .Rmd renderuje się on poprawnie,
- w animowanym i interaktywnym wykresie prezentującym zmianę ludności w najliczniejszych krajach świata w pewnych miejscach niektóre słupki wykonują dziwne nieprzewidziane przemieszczenia. Jest to błąd frameworka, ponieważ przy zmianie ilości wyświetlanych krajów błędy te występują w różnych miejscach (latach).
Błędy z kable_styling:
- w wynikowym HTML’u w niektórych tabelach widoczny jest kod html psujący czytelność - w arkuszu .Rmd tabele renderują się poprawnie.
Użyte biblioteki
library(dplyr)
library(plotly)
library(ggplot2)
library(readxl)
library(tidyr)
library(knitr)
library(kableExtra)
library(TTR)
library(data.table)
library(caret)
library(corrplot)
library(RColorBrewer)
library(randomForest)
set.seed(23)Gold Prices
Wczytywanie i czyszczenie danych
- nadanie właściwych typów danych,
- pozostawienie do dalszych rozważań jedynie ceny w walucie USD,
- zmiana nazw kolumn dla AM and PM fixing,
Gold.prices <- read.csv("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/Gold prices.csv",
colClasses = c(rep("Date", 1),
rep("numeric", 2),
rep("NULL", 4)),
col.names = c('Date',
'Morning.Fix.USD',
'Afternoon.Fix.USD',
rep("NULL", 4)),
header = TRUE)- uzupełnijnie brakujących wartości (NA) w kolumnach z ceną otwarcia i zamknięcia, wartością z sąsiedniej kolumny (w całym zbiorze nie ma sytuacji gdzie brakują obydwie)
- dodanie kolumny USD z uśrednioną ceną otwarcia i zamknięcia
Gold.prices <- Gold.prices %>%
mutate(Morning.Fix.USD = coalesce(Morning.Fix.USD, Afternoon.Fix.USD),
Afternoon.Fix.USD = coalesce(Afternoon.Fix.USD, Morning.Fix.USD),
USD = (Morning.Fix.USD + Afternoon.Fix.USD) / 2)- utworzenie zbioru ze średnią roczną ceną złota
Gold.prices.yearly <- Gold.prices %>%
mutate(Year = as.numeric(substr(Date, 1, 4))) %>%
group_by(Year) %>%
summarize( USD = (mean(Morning.Fix.USD) + mean(Afternoon.Fix.USD)) / 2)Podsumowanie danych
Zbiór zawiera codzienne wyceny złota podczas sesji otwarcia i zamknięcia od dnia 1968-01-02 do 2021-09-29.
head(Gold.prices) %>%
kable() %>%
kable_styling("striped", full_width = F, position = 'left')| Date | Morning.Fix.USD | Afternoon.Fix.USD | USD |
|---|---|---|---|
| 2021-09-29 | 1741.65 | 1737.15 | 1739.400 |
| 2021-09-28 | 1739.65 | 1733.75 | 1736.700 |
| 2021-09-27 | 1749.15 | 1755.30 | 1752.225 |
| 2021-09-24 | 1755.15 | 1746.80 | 1750.975 |
| 2021-09-23 | 1771.05 | 1750.00 | 1760.525 |
| 2021-09-22 | 1775.35 | 1773.40 | 1774.375 |
data.frame(nrow(Gold.prices)) %>%
rename("Liczba próbek" = 1) %>%
kable() %>%
kable_styling(full_width = FALSE, position = 'left')| Liczba próbek |
|---|
| 13585 |
summary(Gold.prices) %>%
kable() %>%
kable_styling("striped", full_width = F, position = 'left')| Date | Morning.Fix.USD | Afternoon.Fix.USD | USD | |
|---|---|---|---|---|
| Min. :1968-01-02 | Min. : 34.77 | Min. : 34.75 | Min. : 34.76 | |
| 1st Qu.:1981-06-10 | 1st Qu.: 280.50 | 1st Qu.: 280.30 | 1st Qu.: 280.27 | |
| Median :1994-11-14 | Median : 383.30 | Median : 383.45 | Median : 383.38 | |
| Mean :1994-11-16 | Mean : 575.17 | Mean : 574.98 | Mean : 575.07 | |
| 3rd Qu.:2008-04-23 | 3rd Qu.: 841.75 | 3rd Qu.: 838.25 | 3rd Qu.: 841.00 | |
| Max. :2021-09-29 | Max. :2061.50 | Max. :2067.15 | Max. :2058.15 |
Analiza wartości ceny złota
Na interaktywnym wykresie widzimy zmianę cen otwarcia w czasie.
p <- ggplot(Gold.prices, aes(x = Date)) +
geom_line(aes(y = USD), color = "gold") +
theme_minimal()
ggplotly(p)World development indicators (WDI)
Wczytywanie zbioru danych
- podczas wczytywania uwzględniane są znaki wartości pustych w zbiorze
- pozbycie się informacji o źródle pochodzenia zbioru poprzez podanie zakresu czytania zbioru
World_Development_Indicators <- read_excel("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/World_Development_Indicators.xlsx",
na = '..',
range = "A1:BC44305")Czyszczenie zbioru
- usunięcie elementów innych niż kraje z kolumny
Country Name, pozostawienie statystyk dla całego swiata w zbiorze krajów,
World_Development_Indicators <- World_Development_Indicators %>%
filter(!`Country Name` %in% c("Low & middle income","Low income","Lower middle income","Middle income","Upper middle income","High income"))- wyodrębnienie kodów serii do osobnej tabeli oraz usunięcie jej z przetwarzanego zbioru,
World_Development_Indicators.Series_Codes <- select(World_Development_Indicators, `Series Name`, `Series Code`)
World_Development_Indicators <- select(World_Development_Indicators, -`Series Code`)- przeniesienie pojedyńczych obserwacji do osobnych wierszy
World_Development_Indicators <- World_Development_Indicators %>%
pivot_longer(cols = `1970 [YR1970]`:`2020 [YR2020]`, names_to = "Year") %>%
group_by(`Series Name`) %>%
mutate(row = row_number()) %>%
tidyr::pivot_wider(names_from = `Series Name`, values_from = value) %>%
select(-row)- poprawa kolumny Year: wyodrębnienie lat jako numerycznych wartości
World_Development_Indicators <- World_Development_Indicators %>%
mutate(Year = as.numeric(substr(Year, 1, 4)))Podsumowanie danych
country.count <- length(unique(World_Development_Indicators$`Country Name`)) - 1
indicators.count <- World_Development_Indicators %>%
select(-`Country Name`, -`Country Code`, -Year) %>%
ncol
WDI_summary <- data.frame(country.count, indicators.count) %>%
rename("Liczba krajów" = country.count,
"Liczba wskaźników" = indicators.count)
kable(WDI_summary) %>%
kable_styling(full_width = FALSE, position = 'left')| Liczba krajów | Liczba wskaźników |
|---|---|
| 201 | 213 |
| Lista krajów dostępnych w zbiorze |
|---|
| Afghanistan |
| Albania |
| Algeria |
| American Samoa |
| Andorra |
| Angola |
| Antigua and Barbuda |
| Argentina |
| Armenia |
| Aruba |
| Australia |
| Austria |
| Azerbaijan |
| Bahamas, The |
| Bahrain |
| Bangladesh |
| Barbados |
| Belarus |
| Belgium |
| Belize |
| Benin |
| Bermuda |
| Bhutan |
| Bolivia |
| Brazil |
| British Virgin Islands |
| Bulgaria |
| Burundi |
| Cambodia |
| Cameroon |
| Canada |
| Cayman Islands |
| Central African Republic |
| Chad |
| Channel Islands |
| Chile |
| China |
| Colombia |
| Comoros |
| Congo, Dem. Rep. |
| Congo, Rep. |
| Costa Rica |
| Croatia |
| Cuba |
| Curacao |
| Cyprus |
| Czech Republic |
| Denmark |
| Djibouti |
| Dominica |
| Dominican Republic |
| Ecuador |
| Egypt, Arab Rep. |
| El Salvador |
| Equatorial Guinea |
| Eritrea |
| Estonia |
| Eswatini |
| Ethiopia |
| Faroe Islands |
| Fiji |
| Finland |
| France |
| French Polynesia |
| Gabon |
| Gambia, The |
| Georgia |
| Germany |
| Ghana |
| Gibraltar |
| Greece |
| Greenland |
| Grenada |
| Guam |
| Guatemala |
| Guinea |
| Guinea-Bissau |
| Guyana |
| Haiti |
| Honduras |
| Hong Kong SAR, China |
| Hungary |
| Iceland |
| India |
| Indonesia |
| Iran, Islamic Rep. |
| Iraq |
| Ireland |
| Isle of Man |
| Israel |
| Italy |
| Jamaica |
| Japan |
| Jordan |
| Kazakhstan |
| Kenya |
| Kiribati |
| Korea, Dem. People’s Rep. |
| Korea, Rep. |
| Kosovo |
| Kuwait |
| Kyrgyz Republic |
| Lao PDR |
| Latvia |
| Lebanon |
| Lesotho |
| Liberia |
| Libya |
| Liechtenstein |
| Lithuania |
| Luxembourg |
| Macao SAR, China |
| Madagascar |
| Malawi |
| Malaysia |
| Maldives |
| Mali |
| Malta |
| Marshall Islands |
| Mauritania |
| Mauritius |
| Mexico |
| Micronesia, Fed. Sts. |
| Moldova |
| Monaco |
| Mongolia |
| Montenegro |
| Morocco |
| Mozambique |
| Myanmar |
| Namibia |
| Nepal |
| Netherlands |
| New Caledonia |
| New Zealand |
| Nicaragua |
| Niger |
| Nigeria |
| North Macedonia |
| Norway |
| Oman |
| Pakistan |
| Panama |
| Papua New Guinea |
| Paraguay |
| Peru |
| Philippines |
| Poland |
| Portugal |
| Puerto Rico |
| Qatar |
| Romania |
| Russian Federation |
| Rwanda |
| San Marino |
| Sao Tome and Principe |
| Saudi Arabia |
| Senegal |
| Serbia |
| Seychelles |
| Sierra Leone |
| Singapore |
| Sint Maarten (Dutch part) |
| Slovak Republic |
| Slovenia |
| Solomon Islands |
| South Africa |
| South Sudan |
| Spain |
| St. Vincent and the Grenadines |
| Sudan |
| Suriname |
| Sweden |
| Switzerland |
| Syrian Arab Republic |
| Tajikistan |
| Tanzania |
| Thailand |
| Togo |
| Tonga |
| Trinidad and Tobago |
| Tunisia |
| Turkey |
| Turks and Caicos Islands |
| Tuvalu |
| Uganda |
| Ukraine |
| United Arab Emirates |
| United Kingdom |
| United States |
| Uruguay |
| Uzbekistan |
| Vanuatu |
| Venezuela, RB |
| Vietnam |
| Virgin Islands (U.S.) |
| West Bank and Gaza |
| Yemen, Rep. |
| Zambia |
| Zimbabwe |
| Bosnia and Herzegovina |
| World |
| Lista dostępnych wskaźników |
|---|
| Country Name |
| Country Code |
| Year |
| Urban population growth (annual %) |
| Urban population (% of total population) |
| Value lost due to electrical outages (% of sales for affected firms) |
| Urban population |
| Urban land area (sq. km) |
| Unemployment, total (% of total labor force) (national estimate) |
| Unemployment with advanced education (% of total labor force with advanced education) |
| Transport services (% of commercial service exports) |
| Transport services (% of commercial service imports) |
| Trained teachers in upper secondary education (% of total teachers) |
| Trained teachers in secondary education (% of total teachers) |
| Trained teachers in primary education (% of total teachers) |
| Trademark applications, direct nonresident |
| Trade in services (% of GDP) |
| Trade (% of GDP) |
| Trademark applications, direct resident |
| Trademark applications, total |
| Total natural resources rents (% of GDP) |
| Total greenhouse gas emissions (kt of CO2 equivalent) |
| Total greenhouse gas emissions (% change from 1990) |
| Total alcohol consumption per capita (liters of pure alcohol, projected estimates, 15+ years of age) |
| Time required to build a warehouse (days) |
| Time required to enforce a contract (days) |
| Time required to get electricity (days) |
| Taxes on goods and services (current LCU) |
| Taxes on income, profits and capital gains (% of revenue) |
| Taxes on income, profits and capital gains (% of total taxes) |
| Taxes on income, profits and capital gains (current LCU) |
| Taxes on international trade (% of revenue) |
| Taxes on international trade (current LCU) |
| Taxes on goods and services (% value added of industry and services) |
| Taxes on goods and services (% of revenue) |
| Taxes on exports (current LCU) |
| Taxes on exports (% of tax revenue) |
| Taxes less subsidies on products (current US\() </td> </tr> <tr> <td style="text-align:left;"> Taxes less subsidies on products (current LCU) </td> </tr> <tr> <td style="text-align:left;"> Taxes less subsidies on products (constant LCU) </td> </tr> <tr> <td style="text-align:left;"> Tax revenue (current LCU) </td> </tr> <tr> <td style="text-align:left;"> Tax revenue (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> Tax payments (number) </td> </tr> <tr> <td style="text-align:left;"> Survival to age 65, female (% of cohort) </td> </tr> <tr> <td style="text-align:left;"> Survival to age 65, male (% of cohort) </td> </tr> <tr> <td style="text-align:left;"> Suicide mortality rate (per 100,000 population) </td> </tr> <tr> <td style="text-align:left;"> Suicide mortality rate, female (per 100,000 female population) </td> </tr> <tr> <td style="text-align:left;"> Suicide mortality rate, male (per 100,000 male population) </td> </tr> <tr> <td style="text-align:left;"> Stocks traded, turnover ratio of domestic shares (%) </td> </tr> <tr> <td style="text-align:left;"> Stocks traded, total value (current US\)) |
| Stocks traded, total value (% of GDP) |
| Strength of legal rights index (0=weak to 12=strong) |
| Short-term debt (% of total reserves) |
| Short-term debt (% of total external debt) |
| Short-term debt (% of exports of goods, services and primary income) |
| Share of youth not in education, employment or training, female (% of female youth population) |
| Share of youth not in education, employment or training, male (% of male youth population) |
| Share of youth not in education, employment or training, total (% of youth population) |
| Services, value added (% of GDP) |
| Service imports (BoP, current US\() </td> </tr> <tr> <td style="text-align:left;"> Service exports (BoP, current US\)) |
| Self-employed, male (% of male employment) (modeled ILO estimate) |
| Self-employed, total (% of total employment) (modeled ILO estimate) |
| Self-employed, female (% of female employment) (modeled ILO estimate) |
| Secure Internet servers |
| Secure Internet servers (per 1 million people) |
| Secondary education, teachers |
| Secondary education, pupils |
| Scientific and technical journal articles |
| School enrollment, tertiary (gross), gender parity index (GPI) |
| S&P Global Equity Indices (annual % change) |
| Rural population growth (annual %) |
| Rural population (% of total population) |
| Rural population |
| Researchers in R&D (per million people) |
| Research and development expenditure (% of GDP) |
| Renewable energy consumption (% of total final energy consumption) |
| Renewable internal freshwater resources per capita (cubic meters) |
| Renewable internal freshwater resources, total (billion cubic meters) |
| Renewable electricity output (% of total electricity output) |
| Real interest rate (%) |
| Pupil-teacher ratio, upper secondary |
| Pupil-teacher ratio, tertiary |
| Pupil-teacher ratio, secondary |
| Pupil-teacher ratio, primary |
| Pupil-teacher ratio, preprimary |
| Rail lines (total route-km) |
| Railways, goods transported (million ton-km) |
| Railways, passengers carried (million passenger-km) |
| Proportion of seats held by women in national parliaments (%) |
| Primary income payments (BoP, current US\() </td> </tr> <tr> <td style="text-align:left;"> Primary income receipts (BoP, current US\)) |
| Primary school starting age (years) |
| Prevalence of undernourishment (% of population) |
| Portfolio investment, net (BoP, current US\() </td> </tr> <tr> <td style="text-align:left;"> Portfolio investment, bonds (PPG + PNG) (NFL, current US\)) |
| Portfolio equity, net inflows (BoP, current US\() </td> </tr> <tr> <td style="text-align:left;"> Population, total </td> </tr> <tr> <td style="text-align:left;"> Population, male </td> </tr> <tr> <td style="text-align:left;"> Population, male (% of total population) </td> </tr> <tr> <td style="text-align:left;"> Population, female (% of total population) </td> </tr> <tr> <td style="text-align:left;"> Population, female </td> </tr> <tr> <td style="text-align:left;"> Population living in slums (% of urban population) </td> </tr> <tr> <td style="text-align:left;"> Population in urban agglomerations of more than 1 million </td> </tr> <tr> <td style="text-align:left;"> Population in the largest city (% of urban population) </td> </tr> <tr> <td style="text-align:left;"> Population in largest city </td> </tr> <tr> <td style="text-align:left;"> Population growth (annual %) </td> </tr> <tr> <td style="text-align:left;"> Population density (people per sq. km of land area) </td> </tr> <tr> <td style="text-align:left;"> Population ages 65 and above (% of total population) </td> </tr> <tr> <td style="text-align:left;"> Population ages 15-64 (% of total population) </td> </tr> <tr> <td style="text-align:left;"> Population ages 0-14 (% of total population) </td> </tr> <tr> <td style="text-align:left;"> PM2.5 air pollution, mean annual exposure (micrograms per cubic meter) </td> </tr> <tr> <td style="text-align:left;"> PM2.5 air pollution, population exposed to levels exceeding WHO guideline value (% of total) </td> </tr> <tr> <td style="text-align:left;"> PM2.5 pollution, population exposed to levels exceeding WHO Interim Target-1 value (% of total) </td> </tr> <tr> <td style="text-align:left;"> PM2.5 pollution, population exposed to levels exceeding WHO Interim Target-2 value (% of total) </td> </tr> <tr> <td style="text-align:left;"> PM2.5 pollution, population exposed to levels exceeding WHO Interim Target-3 value (% of total) </td> </tr> <tr> <td style="text-align:left;"> Part time employment, total (% of total employment) </td> </tr> <tr> <td style="text-align:left;"> Patent applications, nonresidents </td> </tr> <tr> <td style="text-align:left;"> Patent applications, residents </td> </tr> <tr> <td style="text-align:left;"> Number of under-five deaths </td> </tr> <tr> <td style="text-align:left;"> Nitrous oxide emissions (% change from 1990) </td> </tr> <tr> <td style="text-align:left;"> Nitrous oxide emissions (thousand metric tons of CO2 equivalent) </td> </tr> <tr> <td style="text-align:left;"> Nitrous oxide emissions in energy sector (% of total) </td> </tr> <tr> <td style="text-align:left;"> Net primary income (Net income from abroad) (current US\)) |
| Net primary income (Net income from abroad) (current LCU) |
| Net primary income (Net income from abroad) (constant LCU) |
| Net primary income (BoP, current US\() </td> </tr> <tr> <td style="text-align:left;"> Net official development assistance received (current US\)) |
| Net official aid received (current US\() </td> </tr> <tr> <td style="text-align:left;"> Net domestic credit (current LCU) </td> </tr> <tr> <td style="text-align:left;"> Net acquisition of financial assets (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> Natural gas rents (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> Mortality rate, infant (per 1,000 live births) </td> </tr> <tr> <td style="text-align:left;"> Mortality caused by road traffic injury (per 100,000 population) </td> </tr> <tr> <td style="text-align:left;"> Methane emissions (% change from 1990) </td> </tr> <tr> <td style="text-align:left;"> Methane emissions (kt of CO2 equivalent) </td> </tr> <tr> <td style="text-align:left;"> Methane emissions in energy sector (thousand metric tons of CO2 equivalent) </td> </tr> <tr> <td style="text-align:left;"> Merchandise exports to high-income economies (% of total merchandise exports) </td> </tr> <tr> <td style="text-align:left;"> Manufacturing, value added (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> Literacy rate, adult total (% of people ages 15 and above) </td> </tr> <tr> <td style="text-align:left;"> Life expectancy at birth, total (years) </td> </tr> <tr> <td style="text-align:left;"> Lending interest rate (%) </td> </tr> <tr> <td style="text-align:left;"> Land area (sq. km) </td> </tr> <tr> <td style="text-align:left;"> Labor force, total </td> </tr> <tr> <td style="text-align:left;"> International tourism, expenditures (current US\)) |
| International migrant stock (% of population) |
| Interest payments (% of expense) |
| Inflation, consumer prices (annual %) |
| Individuals using the Internet (% of population) |
| Income share held by highest 10% |
| Imports of goods and services (current US\() </td> </tr> <tr> <td style="text-align:left;"> Imports of goods and services (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> ICT goods exports (% of total goods exports) </td> </tr> <tr> <td style="text-align:left;"> Gross savings (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> Gross national expenditure (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> Gross national expenditure (current US\)) |
| Gross savings (current US\() </td> </tr> <tr> <td style="text-align:left;"> Gross domestic savings (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> Gross domestic savings (current US\)) |
| Government expenditure on education, total (% of GDP) |
| Goods exports (BoP, current US\() </td> </tr> <tr> <td style="text-align:left;"> Goods imports (BoP, current US\)) |
| GNI growth (annual %) |
| GDP per capita (current US\() </td> </tr> <tr> <td style="text-align:left;"> GDP per capita growth (annual %) </td> </tr> <tr> <td style="text-align:left;"> GDP growth (annual %) </td> </tr> <tr> <td style="text-align:left;"> GDP (current US\)) |
| Fuel exports (% of merchandise exports) |
| Fuel imports (% of merchandise imports) |
| Food exports (% of merchandise exports) |
| Food imports (% of merchandise imports) |
| External debt stocks (% of GNI) |
| Exports of goods and services (current US\() </td> </tr> <tr> <td style="text-align:left;"> Exports of goods and services (annual % growth) </td> </tr> <tr> <td style="text-align:left;"> Expense (% of GDP) </td> </tr> <tr> <td style="text-align:left;"> Employment in industry (% of total employment) (modeled ILO estimate) </td> </tr> <tr> <td style="text-align:left;"> Employment in services (% of total employment) (modeled ILO estimate) </td> </tr> <tr> <td style="text-align:left;"> Employment in agriculture (% of total employment) (modeled ILO estimate) </td> </tr> <tr> <td style="text-align:left;"> Employers, total (% of total employment) (modeled ILO estimate) </td> </tr> <tr> <td style="text-align:left;"> Electricity production from renewable sources, excluding hydroelectric (kWh) </td> </tr> <tr> <td style="text-align:left;"> Electricity production from renewable sources, excluding hydroelectric (% of total) </td> </tr> <tr> <td style="text-align:left;"> Electricity production from oil, gas and coal sources (% of total) </td> </tr> <tr> <td style="text-align:left;"> Electricity production from coal sources (% of total) </td> </tr> <tr> <td style="text-align:left;"> Electricity production from hydroelectric sources (% of total) </td> </tr> <tr> <td style="text-align:left;"> Electricity production from natural gas sources (% of total) </td> </tr> <tr> <td style="text-align:left;"> Electricity production from nuclear sources (% of total) </td> </tr> <tr> <td style="text-align:left;"> Ease of doing business score (0 = lowest performance to 100 = best performance) </td> </tr> <tr> <td style="text-align:left;"> Diabetes prevalence (% of population ages 20 to 79) </td> </tr> <tr> <td style="text-align:left;"> Deposit interest rate (%) </td> </tr> <tr> <td style="text-align:left;"> Current health expenditure per capita (current US\)) |
| Current health expenditure (% of GDP) |
| Consumer price index (2010 = 100) |
| CO2 emissions from solid fuel consumption (% of total) |
| CO2 emissions from solid fuel consumption (kt) |
| CO2 emissions from transport (% of total fuel combustion) |
| CO2 intensity (kg per kg of oil equivalent energy use) |
| CO2 emissions from residential buildings and commercial and public services (% of total fuel combustion) |
| CO2 emissions from other sectors, excluding residential buildings and commercial and public services (% of total fuel combustion) |
| CO2 emissions from manufacturing industries and construction (% of total fuel combustion) |
| CO2 emissions from liquid fuel consumption (kt) |
| CO2 emissions from liquid fuel consumption (% of total) |
| CO2 emissions from gaseous fuel consumption (kt) |
| CO2 emissions from gaseous fuel consumption (% of total) |
| CO2 emissions from electricity and heat production, total (% of total fuel combustion) |
| CO2 emissions (metric tons per capita) |
| CO2 emissions (kt) |
| CO2 emissions (kg per PPP $ of GDP) |
| CO2 emissions (kg per 2017 PPP $ of GDP) |
| CO2 emissions (kg per 2010 US$ of GDP) |
| Birth rate, crude (per 1,000 people) |
| Bank capital to assets ratio (%) |
| Average number of visits or required meetings with tax officials (for affected firms) |
| Average precipitation in depth (mm per year) |
| Automated teller machines (ATMs) (per 100,000 adults) |
| Account ownership at a financial institution or with a mobile-money-service provider (% of population ages 15+) |
| Access to electricity (% of population) |
S&P Composite
Wczytywanie danych
SP.Composite <- read.csv("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/S&P Composite.csv")Czyszczenie danych
- zmiana nazwy oraz typ na właściwy kolumny z datą
- zmiana nazwy Cyclicaly.Adjusted.PE.Ratio na skrót CAPE -
SP.Composite <- SP.Composite %>%
rename(Date = Year,
CAPE = Cyclically.Adjusted.PE.Ratio) %>%
mutate(Date = as.Date(Date))Znaczenie atrybutów
- S.P.Composite - nominalna wartość indexu,
- Divident - nominalna dywidenta,
- Earnings - nominalne zarobki na indeksie,
- CPI - wskaźnik cen towarów i usług konsumpcyjnych. Najpopularniejsza na świecie miara inflacji/deflacji,
- Long.Interest.Rate - stopy procentowe dziesięcioletnich obligacji rządowych,
- Real.Price - realna wartość indexu,
- Real.Divident - realna dywidenta,
- Real.Earnings - realne zarobki na indeksie,
- CAPE (Cyclicaly.Adjusted.PE.Ratio) - cyklicznie dostosowywany wskaźnik ceny do zysków. Definiuje się go jako cenę podzieloną przez średnią z dziesięciu lat zarobków, skorygowaną o inflację.
plot.data_SP.Composite <- SP.Composite %>%
pivot_longer(2:10) %>%
filter(!is.na(value))
plot.data_SP.Composite %>%
ggplot(aes(x = Date, y = value)) +
geom_line() +
facet_wrap(name ~ ., scales="free", ncol = 3) +
theme_minimal()
Podsumowanie danych
head(SP.Composite) %>%
kable() %>%
kable_styling("striped", full_width = F, position = 'left') %>%
scroll_box( width = '100%')| Date | S.P.Composite | Dividend | Earnings | CPI | Long.Interest.Rate | Real.Price | Real.Dividend | Real.Earnings | CAPE |
|---|---|---|---|---|---|---|---|---|---|
| 2021-10-31 | 3700.650 | NA | NA | 260.1098 | 0.93 | 3700.650 | NA | NA | 33.73946 |
| 2021-09-30 | 4493.280 | NA | NA | 273.9832 | 1.29 | 4477.204 | NA | NA | 38.34228 |
| 2021-08-31 | 4454.206 | NA | NA | 273.6565 | 1.28 | 4443.570 | NA | NA | 38.09043 |
| 2021-07-31 | 4363.713 | NA | NA | 273.0030 | 1.32 | 4363.713 | NA | NA | 37.44349 |
| 2021-06-30 | 4238.490 | 57.86504 | 158.74 | 271.6960 | 1.52 | 4258.879 | 58.14340 | 159.5036 | 36.69631 |
| 2021-05-31 | 4167.850 | 57.78782 | 148.56 | 269.1950 | 1.62 | 4226.807 | 58.60528 | 150.6615 | 36.55215 |
data.frame(nrow(Gold.prices)) %>%
rename("Liczba próbek" = 1) %>%
kable() %>%
kable_styling(full_width = FALSE, position = 'left')| Liczba próbek |
|---|
| 13585 |
summary(SP.Composite) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover"), position = 'left') %>%
scroll_box( width = '100%')| Date | S.P.Composite | Dividend | Earnings | CPI | Long.Interest.Rate | Real.Price | Real.Dividend | Real.Earnings | CAPE | |
|---|---|---|---|---|---|---|---|---|---|---|
| Min. :1871-01-31 | Min. : 2.730 | Min. : 0.1800 | Min. : 0.1600 | Min. : 6.28 | Min. : 0.620 | Min. : 73.9 | Min. : 5.445 | Min. : 4.576 | Min. : 4.784 | |
| 1st Qu.:1908-10-07 | 1st Qu.: 7.902 | 1st Qu.: 0.4202 | 1st Qu.: 0.5608 | 1st Qu.: 10.20 | 1st Qu.: 3.171 | 1st Qu.: 186.6 | 1st Qu.: 9.417 | 1st Qu.: 14.063 | 1st Qu.:11.898 | |
| Median :1946-06-15 | Median : 17.370 | Median : 0.8717 | Median : 1.4625 | Median : 20.35 | Median : 3.815 | Median : 283.3 | Median :14.411 | Median : 23.524 | Median :16.381 | |
| Mean :1946-06-15 | Mean : 327.968 | Mean : 6.7321 | Mean : 15.3714 | Mean : 62.39 | Mean : 4.504 | Mean : 622.0 | Mean :17.498 | Mean : 34.907 | Mean :17.215 | |
| 3rd Qu.:1984-02-21 | 3rd Qu.: 164.400 | 3rd Qu.: 7.0525 | 3rd Qu.: 14.7258 | 3rd Qu.:102.28 | 3rd Qu.: 5.139 | 3rd Qu.: 707.0 | 3rd Qu.:22.301 | 3rd Qu.: 43.768 | 3rd Qu.:20.913 | |
| Max. :2021-10-31 | Max. :4493.280 | Max. :59.6800 | Max. :158.7400 | Max. :273.98 | Max. :15.320 | Max. :4477.2 | Max. :63.511 | Max. :159.504 | Max. :44.198 | |
| NA | NA | NA’s :4 | NA’s :4 | NA | NA | NA | NA’s :4 | NA’s :4 | NA’s :120 |
Currency Exchange Rates
Wczytywanie danych
Currency.Exchange.Rates <- read.csv("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/CurrencyExchangeRates.csv")Czyszczenie danych
- zmiana typu kolumny z datą
Currency.Exchange.Rates <- Currency.Exchange.Rates %>%
mutate(Date = as.Date(Date))Podsumowanie danych
Zbiór zawiera codzienny kurs wymiany walut od dnia 1995-01-02 do 2018-05-02.
Currency.Exchange.Rates %>%
names %>%
data.frame() %>%
rename('Dostępne waluty' = '.') %>%
kable %>%
kable_styling("striped", full_width = F, position = 'left') %>%
scroll_box(width = '400px', height = '400px')| Dostępne waluty |
|---|
| Date |
| Algerian.Dinar |
| Australian.Dollar |
| Bahrain.Dinar |
| Bolivar.Fuerte |
| Botswana.Pula |
| Brazilian.Real |
| Brunei.Dollar |
| Canadian.Dollar |
| Chilean.Peso |
| Chinese.Yuan |
| Colombian.Peso |
| Czech.Koruna |
| Danish.Krone |
| Euro |
| Hungarian.Forint |
| Icelandic.Krona |
| Indian.Rupee |
| Indonesian.Rupiah |
| Iranian.Rial |
| Israeli.New.Sheqel |
| Japanese.Yen |
| Kazakhstani.Tenge |
| Korean.Won |
| Kuwaiti.Dinar |
| Libyan.Dinar |
| Malaysian.Ringgit |
| Mauritian.Rupee |
| Mexican.Peso |
| Nepalese.Rupee |
| New.Zealand.Dollar |
| Norwegian.Krone |
| Nuevo.Sol |
| Pakistani.Rupee |
| Peso.Uruguayo |
| Philippine.Peso |
| Polish.Zloty |
| Qatar.Riyal |
| Rial.Omani |
| Russian.Ruble |
| Saudi.Arabian.Riyal |
| Singapore.Dollar |
| South.African.Rand |
| Sri.Lanka.Rupee |
| Swedish.Krona |
| Swiss.Franc |
| Thai.Baht |
| Trinidad.And.Tobago.Dollar |
| Tunisian.Dinar |
| U.A.E..Dirham |
| U.K..Pound.Sterling |
| U.S..Dollar |
Bitcoin dataset
Wczytywanie danych
Bitcoin.prices <- read.csv("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/Bitcoin/BCHAIN-MKPRU.csv",
colClasses = c(rep("Date", 1),
rep("numeric", 1)),
col.names = c('Date',
'USD'))
Bitcoin.trade.volume <- read.csv("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/Bitcoin/BCHAIN-TRVOU.csv",
colClasses = c(rep("Date", 1),
rep("numeric", 1)),
col.names = c('Date',
'Trade Volume'))
Bitcoin.mine.difficulty <- read.csv("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/Bitcoin/BCHAIN-DIFF.csv",
colClasses = c(rep("Date", 1),
rep("numeric", 1)),
col.names = c('Date',
'Mine difficulty'))
Bitcoin.hash.rate <- read.csv("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/Bitcoin/BCHAIN-HRATE.csv",
colClasses = c(rep("Date", 1),
rep("numeric", 1)),
col.names = c('Date',
'Hash rate'))
Bitcoin <- Bitcoin.prices %>%
merge(Bitcoin.trade.volume, by = "Date") %>%
merge(Bitcoin.mine.difficulty, by = "Date") %>%
merge(Bitcoin.hash.rate, by = "Date")Podsumowanie danych
Zestaw danych zawiera codzienne informacje od początku istnienia Bitcoina.
Znaczenie atrybutów: * USD - Bitcoin Market Price USD,Average USD market price across major bitcoin exchanges. * Trade volume - Bitcoin USD Exchange Trade Volume,The total USD value of trading volume on major bitcoin exchanges. * Mine difficulty - Bitcoin Difficulty,A relative measure of how difficult it is to find a new block. The difficulty is adjusted periodically as a function of how much hashing power has been deployed by the network of miners. * Hash rate - Bitcoin Hash Rate,The estimated number of tera hashes per second (trillions of hashes per second) the Bitcoin network is performing.
tail(Bitcoin) %>%
kable %>%
kable_styling("striped", full_width = F, position = 'left') | Date | USD | Trade.Volume | Mine.difficulty | Hash.rate | |
|---|---|---|---|---|---|
| 4654 | 2021-09-30 | 41522.38 | 221224597 | 1.899764e+13 | 161488615 |
| 4655 | 2021-10-01 | 43757.81 | 360342502 | 1.899764e+13 | 132212901 |
| 4656 | 2021-10-02 | 48140.11 | 688291407 | 1.899764e+13 | 177543039 |
| 4657 | 2021-10-03 | 47727.10 | 184243788 | 1.899764e+13 | 141656680 |
| 4658 | 2021-10-04 | 48205.72 | 183312374 | 1.900912e+13 | 147411968 |
| 4659 | 2021-10-05 | 49143.95 | 370887916 | 1.989305e+13 | 162177736 |
summary(Bitcoin) %>%
kable %>%
kable_styling("striped", full_width = F, position = 'left')| Date | USD | Trade.Volume | Mine.difficulty | Hash.rate | |
|---|---|---|---|---|---|
| Min. :2009-01-03 | Min. : 0.00 | Min. :0.000e+00 | Min. :0.000e+00 | Min. : 0 | |
| 1st Qu.:2012-03-12 | 1st Qu.: 7.21 | 1st Qu.:1.948e+05 | 1st Qu.:1.689e+06 | 1st Qu.: 12 | |
| Median :2015-05-21 | Median : 431.89 | Median :6.824e+06 | Median :4.881e+10 | Median : 356089 | |
| Mean :2015-05-21 | Mean : 5132.38 | Mean :1.467e+08 | Mean :3.665e+12 | Mean : 26458258 | |
| 3rd Qu.:2018-07-28 | 3rd Qu.: 6496.35 | 3rd Qu.:1.484e+08 | 3rd Qu.:5.364e+12 | 3rd Qu.: 38265984 | |
| Max. :2021-10-05 | Max. :63554.44 | Max. :5.352e+09 | Max. :2.505e+13 | Max. :198514006 |
Analizy
Animowany wykres zmiany liczby ludności w czasie
Odpalić z puszczoną w tle piosenką “Another One Bites the Dust” zespołu Queen.
Samobójstwa kobiet i mężczyzn na świecie w latach 2000-2019
suicides <- World_Development_Indicators %>%
filter(`Country Name` == 'World') %>%
select(Year, `Suicide mortality rate, female (per 100,000 female population)`, `Suicide mortality rate, male (per 100,000 male population)`) %>%
filter(!is.na(`Suicide mortality rate, female (per 100,000 female population)`))
suicides.male <- suicides %>%
select(Year, `Suicide mortality rate, male (per 100,000 male population)`) %>%
rename(`Suicide mortality rate (per 100,000 of given gender population)` = `Suicide mortality rate, male (per 100,000 male population)`) %>%
mutate(gender = 'male')
suicides.female <- suicides %>%
select(Year, `Suicide mortality rate, female (per 100,000 female population)`) %>%
rename(`Suicide mortality rate (per 100,000 of given gender population)` = `Suicide mortality rate, female (per 100,000 female population)`) %>%
mutate(gender = 'female')
suicides.per.gender <- rbind.data.frame(suicides.male, suicides.female)
p <- suicides.per.gender %>%
ggplot(aes(x = Year, y = `Suicide mortality rate (per 100,000 of given gender population)`)) +
geom_line(aes(colour = gender), size = 1) +
geom_point(colour = 'royalblue', size = 2) +
expand_limits(y = 0) +
ggtitle('Współczynnik samobójstw (na 100,000 osób danej płci)') +
ylab('') +
theme_minimal()
ggplotly(p)Wniosek: Liczba samobójstw na świecie spada.
Korelacja ceny złota do ceny BTC
gold <- Gold.prices %>%
select(Date, USD) %>%
arrange(desc(row_number())) %>%
filter( Date < '2021-09-29') %>%
filter( Date > '2016-01-01') %>%
rename( USD.gold = USD )
BTC_price <- Bitcoin.prices %>%
arrange(desc(row_number())) %>%
filter( Date < '2021-09-29') %>%
filter( Date > '2016-01-01') %>%
rename( USD.BTC = USD )
gold.btc <- gold %>%
inner_join(BTC_price, by = 'Date')
print(paste("Korelacja złota z ceną Bitcoina: ", round(cor(gold.btc$USD.gold, gold.btc$USD.BTC, use = "complete.obs"))))## [1] "Korelacja złota z ceną Bitcoina: 1"coeff.gold.btc <- max(gold.btc$USD.BTC)/max(gold.btc$USD.gold)
gold.btc %>%
ggplot( aes(x = Date) ) +
geom_line( aes(y = USD.gold), color = 'gold' ) +
geom_line( aes(y = USD.BTC/coeff.gold.btc), color = 'orange' ) +
scale_y_continuous(
name = "Cena złota",
sec.axis = sec_axis(~.*coeff.gold.btc, name="Cena BTC")
) +
ggtitle("Cena złota oraz BTC [USD]") +
theme_minimal() +
theme(
axis.title.y = element_text(color = 'gold', size=13),
axis.title.y.right = element_text(color = 'orange', size=13),
axis.text.y = element_text(color = 'gold', size=13),
axis.text.y.right = element_text(color = 'orange', size=13)
)
Wniosek: Pomimo korelacji na poziomie 0.68 wizualna inspekcja nie pokazuje jasnej zależności pomiędzy cenami porównywanych aktywów.
Korelacja złota z indexem S&P Composite
Gold.prices.monthly <- Gold.prices %>%
mutate(Date = substr(Date, 1, 7)) %>%
group_by(Date) %>%
summarize( USD = (mean(Morning.Fix.USD) + mean(Afternoon.Fix.USD)) / 2)
SP.df <- SP.Composite %>%
mutate(Date = substr(Date, 1, 7)) %>%
select(Date, S.P.Composite)
gold.SP <- Gold.prices.monthly %>%
inner_join(SP.df, by = 'Date') %>%
mutate(Date = as.Date(paste0(Date,'-01')))
print(paste("Korelacja złota z indeksem S&P Composite: ", round(cor(gold.SP$USD, gold.SP$S.P.Composite, use = "complete.obs"), 2)))## [1] "Korelacja złota z indeksem S&P Composite: 0.82"coeff.gold.SP <- max(gold.SP$S.P.Composite)/max(gold.SP$USD)
gold.SP %>%
ggplot( aes(x = Date) ) +
geom_line( aes(y = USD), color = 'gold' ) +
geom_line( aes(y = S.P.Composite/coeff.gold.SP), color = 'royalblue' ) +
scale_y_continuous(
name = "Cena złota",
sec.axis = sec_axis(~.*coeff.gold.SP, name="Cena S&P Composite")
) +
ggtitle("Cena złota oraz indeksu S&P Composite [USD]") +
theme_minimal() +
theme(
axis.title.y = element_text(color = 'gold', size=13),
axis.title.y.right = element_text(color = 'royalblue', size=13),
axis.text.y = element_text(color = 'gold', size=13),
axis.text.y.right = element_text(color = 'royalblue', size=13)
)
Wniosek: Pomimo korelacji na poziomie 0.82 wizualna inspekcja nie pokazuje jasnej zależności pomiędzy cenami porównywanych aktywów.
Zbadanie najwyższych korelacji wskaźników rozwoju USA z ceną złota
USA.WDI <- World_Development_Indicators %>%
filter(`Country Name` == 'United States') %>%
merge(Gold.prices.yearly, by = 'Year') %>%
select_if(~ !any(is.na(.)))
USA.WDI.to_cor <- USA.WDI %>%
select(-(1:3))
num_col=ncol(USA.WDI.to_cor[,-1])
out_indx <- which(upper.tri(diag(num_col)))
cor_cols <- USA.WDI.to_cor %>%
do(melt(cor(.[,-1], use="pairwise.complete.obs"), value.name="cor")[out_indx,])
cor_cols <- cor_cols %>%
filter(Var2 == 'USD') %>%
top_n(15) %>%
arrange(desc(cor)) %>%
rename("top correlations" = cor)
cor_cols %>%
kable %>%
kable_styling("striped", full_width = F, position = 'left')%>%
scroll_box(width = '100%')| Var1 | Var2 | top correlations |
|---|---|---|
| Net primary income (BoP, current US\() </td> <td style="text-align:left;"> USD </td> <td style="text-align:right;"> 0.9375048 </td> </tr> <tr> <td style="text-align:left;"> Service exports (BoP, current US\)) | USD | 0.9017878 |
| Goods exports (BoP, current US\() </td> <td style="text-align:left;"> USD </td> <td style="text-align:right;"> 0.8963826 </td> </tr> <tr> <td style="text-align:left;"> Net domestic credit (current LCU) </td> <td style="text-align:left;"> USD </td> <td style="text-align:right;"> 0.8947741 </td> </tr> <tr> <td style="text-align:left;"> Primary income receipts (BoP, current US\)) | USD | 0.8925628 |
| Service imports (BoP, current US\() </td> <td style="text-align:left;"> USD </td> <td style="text-align:right;"> 0.8868864 </td> </tr> <tr> <td style="text-align:left;"> Goods imports (BoP, current US\)) | USD | 0.8723380 |
| GDP (current US\() </td> <td style="text-align:left;"> USD </td> <td style="text-align:right;"> 0.8627224 </td> </tr> <tr> <td style="text-align:left;"> Primary income payments (BoP, current US\)) | USD | 0.8473236 |
| Population ages 65 and above (% of total population) | USD | 0.8421186 |
| GDP per capita (current US$) | USD | 0.8418428 |
| Trade in services (% of GDP) | USD | 0.8413228 |
| Population in urban agglomerations of more than 1 million | USD | 0.8346021 |
| Urban population | USD | 0.8250818 |
| Population, male | USD | 0.8234517 |
cor_cols %>% ggplot(aes(x = reorder(Var1, `top correlations`),
y = `top correlations`,
label = sprintf("%0.2f", round(`top correlations`, digits = 2)))) +
geom_bar(position=position_dodge(), stat="identity", colour="darkgrey", fill = 'lightgrey', width = 0.5) +
geom_text(size = 3, hjust = 1.2) +
theme_minimal() +
coord_flip() +
theme(axis.title = element_blank()) +
ggtitle("Top 15 korelacji złota z wskaźnikami WDI USA ")
Wnioski:
Wskaźniki, które mają najwyższą korelację z ceną złota wskazują raczej na ogólny wzrost godspodarczy.
coeff.income_gold.price <- max(USA.WDI$`Net primary income (BoP, current US$)`)/max(USA.WDI$USD)
USA.WDI %>%
ggplot( aes(x = Year) ) +
geom_line( aes(y = USD), color = 'gold' ) +
geom_line( aes(y = `Net primary income (BoP, current US$)`/coeff.income_gold.price), color = 'royalblue' ) +
scale_y_continuous(
name = "Cena złota",
sec.axis = sec_axis(~.*coeff.gold.SP, name="Net primary income")
) +
ggtitle("Cena złota w porównaniu ze wskaźnikiem przychodu netto w USA") +
theme_minimal() +
theme(
axis.title.y = element_text(color = 'gold', size=13),
axis.title.y.right = element_text(color = 'royalblue', size=13),
axis.text.y = element_text(color = 'gold', size=13),
axis.text.y.right = element_text(color = 'royalblue', size=13)
)
coeff.service_export.price <- max(USA.WDI$`Service exports (BoP, current US$)`)/max(USA.WDI$USD)
USA.WDI %>%
ggplot( aes(x = Year) ) +
geom_line( aes(y = USD), color = 'gold' ) +
geom_line( aes(y = `Service exports (BoP, current US$)` / coeff.service_export.price), color = 'royalblue' ) +
scale_y_continuous(
name = "Cena złota",
sec.axis = sec_axis(~.*coeff.gold.SP, name="Service exports")
) +
ggtitle("Cena złota w porównaniu ze wskaźnikiem eksportu usług w USA") +
theme_minimal() +
theme(
axis.title.y = element_text(color = 'gold', size=13),
axis.title.y.right = element_text(color = 'royalblue', size=13),
axis.text.y = element_text(color = 'gold', size=13),
axis.text.y.right = element_text(color = 'royalblue', size=13)
)
Wnioski:
Wskaźniki WDI są podawane rok rocznie. Uważamy, że próba przewidywania ceny złota w ujęciu rocznym ze względu na zbyt małą ilość danych nie będzie wartościowa. Zamiast prób tworzenia regresora przewidującego cenę złota spróbujemy przewidzieć dobry moment na kupno i sprzedaż kruszcu opierając się o wskaźniki analizy technicznej.
Przewidywnaie dobrego momentu kupna i sprzedaży złota
Zamiast przewidywać cenę złota stworzymy model próbujący znaleźć we wskaźnikach analizy technicznej dobre momenty do kupna lub sprzedaży złota.
Próba oparta bedzie o strategię średnich kroczących (ang. moving averages - MA). Metoda ta polega na obliczeniu średniej ceny złota z okresu czasu o długości N wstecz.
Poza prostymi średnimi kroczącymi (ang. simple moving averages - SMA) wykorzystana jest również wykładnicza średnia krocząca (ang. exponential moving average - EMA). EMA różni się od SMA tym, że podczas obliczania średniej na wartości nakładane są wykładnicze wagi, które maleją wraz z odległością próbki.
Średnie kroczące pozwalają na wygładzenie szumu z szeregów cenowych uwydatniając w ten sposób trendy. Na podstawie wielu średnich kroczących można spróbować określić dobry moment kupna lub sprzedaży patrząc na ich miejsca przecinania.
Zaznaczanie miejsc dobrych do kupna i sprzedaży
Pierwszym krokiem jest ręczne zaznaczenie okresów w których warto było poszerzać lub zawężać ekspozycję swojego portfela inwestycyjnego na złoto.
Odczytanie zbioru z miejscami kupna/sprzedaży
Gold.prices <- read_excel("C:/Users/alili/Desktop/studia/9 semestr/ZED/projekt/Data pack/Gold_prices_with_marked_exposition.xlsx")Czyszczenie zbioru
- wyodrębnienie miejsc kupna i sprzedaży do osobnych kolumn
positive.exposition <- Gold.prices$exposition
positive.exposition[Gold.prices$exposition == -1] <- 0
negative.exposition <- Gold.prices$exposition
negative.exposition[Gold.prices$exposition == 1] <- 0
negative.exposition[Gold.prices$exposition == -1] <- 1
Gold.prices <- Gold.prices %>%
mutate('positive.exposition' = positive.exposition,
'negative.exposition' = negative.exposition,)Wykres przedstawiający miejsca kupna oraz sprzedaży
Podsumowanie ilości dni dobrych do kupna oraz sprzedaży złota
positive.exposition.count <- data.frame(positive.exposition) %>%
filter(positive.exposition > 0) %>%
count() %>%
rename("positive exposition" = n)
negative.exposition.count <- data.frame(negative.exposition) %>%
filter(negative.exposition > 0) %>%
count() %>%
rename("negative exposition" = n)
data.frame(nrow(Gold.prices) , positive.exposition.count, negative.exposition.count) %>%
rename("liczba próbek" = 1,
"positive exposition" = 2,
"negative exposition" = 3) %>%
kable %>%
kable_styling("striped", full_width = F, position = 'left')| liczba próbek | positive exposition | negative exposition |
|---|---|---|
| 13585 | 2686 | 1458 |
Liczba miejsc do kupna jest znacznie wieksza niż miejsc do sprzedaży. Jest to spowodowane tym, że wzrost wartości złota jest powolny i jest więcej okazji do kupna, a spadki szybkie, napędzane emocjami inwestorów.
Poza tym widać, że zbiór jest niezbalansowany.
Obliczanie średnich kroczących
Gold.prices.with.MA <- Gold.prices %>%
arrange(desc(row_number())) %>%
mutate(MA3 = SMA(USD, 3),
MA7 = SMA(USD, 7),
EMA13 = EMA(USD, 13),
MA19 = SMA(USD, 19),
MA50 = SMA(USD, 50),
MA200 = SMA(USD, 200),
MA1095 = SMA(USD, 1095)
) %>%
filter_at(vars(-Date), all_vars(!is.na(.)))
head(Gold.prices.with.MA) %>%
kable() %>%
kable_styling("striped", full_width = F, position = 'left') %>%
scroll_box(width = '100%')| Date | Morning.Fix.USD | Afternoon.Fix.USD | USD | exposition | positive.exposition | negative.exposition | MA3 | MA7 | EMA13 | MA19 | MA50 | MA200 | MA1095 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1972-05-05 | 50.52 | 51.05 | 50.785 | 1 | 1 | 0 | 50.51167 | 50.18786 | 49.91289 | 49.58105 | 48.8150 | 44.99840 | 39.88142 |
| 1972-05-08 | 51.60 | 52.08 | 51.840 | 1 | 1 | 0 | 51.00000 | 50.53429 | 50.18819 | 49.75763 | 48.8763 | 45.04960 | 39.89664 |
| 1972-05-09 | 54.00 | 53.70 | 53.850 | 1 | 1 | 0 | 52.15833 | 51.14857 | 50.71131 | 50.02000 | 48.9825 | 45.10915 | 39.91371 |
| 1972-05-10 | 53.30 | 53.10 | 53.200 | 1 | 1 | 0 | 52.96333 | 51.56643 | 51.06684 | 50.23132 | 49.0771 | 45.16480 | 39.93020 |
| 1972-05-11 | 53.00 | 53.00 | 53.000 | 1 | 1 | 0 | 53.35000 | 51.91786 | 51.34300 | 50.42342 | 49.1711 | 45.21860 | 39.94651 |
| 1972-05-12 | 52.80 | 52.90 | 52.850 | 1 | 1 | 0 | 53.01667 | 52.27143 | 51.55829 | 50.60579 | 49.2699 | 45.27065 | 39.96268 |
Mmmm, jaki piękny zbiór na wykonanie modelu… już nie mogę się doczekać :3
Wykres prezentujący średnie kroczące we fragmencie kursu złota.
Na wykresie zauważyć można punkty przecięcia średnich kroczących, które sugerować mogą podjęcie operacji na rynku.
Klasyfikator
Podzielenie zbioru na zbiór treningowy oraz testowy
Zbiór jest dzielony wedle chronologii próbek, nie w sposób losowy, aby zbiór testowy nie był podobny do zbioru treningowego.
training_set_percentage <- 80
model.df <- Gold.prices.with.MA %>%
select(-(Date:USD), -positive.exposition, -negative.exposition) %>%
mutate(exposition = as.factor(exposition))
training <- model.df[1:round(nrow(model.df)*training_set_percentage/100),]
testing <- model.df[-(1:round(nrow(model.df)*training_set_percentage/100)),]
stopifnot(nrow(testing) + nrow(training) == nrow(model.df))Stworzenie klasyfikatora
set.seed(23)
seeds <- vector(mode = "list", length = 26)
for(i in 1:25) seeds[[i]] <- sample.int(n=1000, 3)
seeds[[26]] <- sample.int(n=1000, 1)
ctrl <- trainControl(seeds = seeds)
fit <- train(exposition ~ .,
data = training,
method = "rf",
trControl = ctrl,
ntree = 20)
rfClasses <- predict(fit, newdata = testing)
confusionMatrix(data = rfClasses, testing$exposition)## Confusion Matrix and Statistics
##
## Reference
## Prediction -1 0 1
## -1 53 36 0
## 0 425 1396 520
## 1 0 0 68
##
## Overall Statistics
##
## Accuracy : 0.6073
## 95% CI : (0.5878, 0.6265)
## No Information Rate : 0.5733
## P-Value [Acc > NIR] : 0.0003016
##
## Kappa : 0.1264
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: -1 Class: 0 Class: 1
## Sensitivity 0.11088 0.9749 0.11565
## Specificity 0.98218 0.1135 1.00000
## Pos Pred Value 0.59551 0.5963 1.00000
## Neg Pred Value 0.82358 0.7707 0.78601
## Prevalence 0.19135 0.5733 0.23539
## Detection Rate 0.02122 0.5588 0.02722
## Detection Prevalence 0.03563 0.9371 0.02722
## Balanced Accuracy 0.54653 0.5442 0.55782Wnioski
Wyniki modelu są obiecujące, choć początkowo na to nie wskazują.
- Accuracy (dokładność) modelu jest na poziomie 60%.
- Sensitivity (wrażliwość, czułość - wskaźnik wartości True Positive) przedziały czau w których warto było kupować były duże. Klasyfikator może wskazywać znacznie węższe przedziały i niskie wartosci dla klas kupna i sprzedaży w tym przypadku nie muszą oznaczać klasyfikatora niskiej jakości.
- Specificity (specyficzność - wskaźnik wartości True Negative) klas sprzedaży oraz kupna jest bardzo wysokie co oznacza, że klasyfikator nie często myli się podczas predykcji tych miejsc - jest to dobry sygnał.
- z macierzy pomyłek odczytać można, że model nie myli się pomiędzy klasami kupno-sprzedaż
Wynik modelu najlepiej będzie ocenić wizualnie wyświetlając miejsca, które model wskazał jako dobre do kupna lub sprzedaży.
Ważność atrybutów
indicators.importance <- data.frame(importance(fit$finalModel)) %>%
mutate(names = rownames(.))
indicators.importance %>%
ggplot(aes(x = reorder(names, -MeanDecreaseGini),
y = MeanDecreaseGini)) +
geom_col() +
labs(x = "Atrybuty", y = "Ważność atrybutu") +
ggtitle("Ważności atrybutów") +
theme_minimal()
Model największą wagę przywiązuje do średnich kroczących z dłuższego okresu. Średnie liczone na dłuższym okresie bardziej wygładzają wykres i pokazują ogólny trend zachodzący w kursie. Przecięcia średnich krótszego okresu ze średnimi dłuższego okredu definitywnie pokazują zmianę trendu. Poleganie tylko na średnich długiego okresu nie jest dobre, ponieważ wraz z zwiększaniem okresu liczenia średniej wzrasta opóźnienie ich reakcji w stosunku do zmiany kursu.
Wizualizacja predykcji
Wnioski:
Model jest bardzo zachowawczy w swoich decyzjach i niepewnie decyduje się na inwestycje (pewnie z uwagi na duże przeuczenie - zauważone na sam koniec), jednak gdy już to zrobi robi to przeważnie trafnie. Model wykazuje również tendencję do akumulacji aktywa i niechętnie je odsprzedaje.
Metoda średnich kroczących nie jest skutecznym narzędziem podczas konsolidacji rynku. Zauważyć można, że model w momencie konsolidacji występującej w latach (około 2014 - 2019) nie popełnia wielu błędów i raczej ją przeczekał dokupując na dołkach. Sugeruje to potencjalnie wyższą skuteczność niż tradycyjna metoda.
Utrudnieniem dla klasyfikatora jest fakt, że w ostatnich latach nastąpił znacznie większy ruch kursu złota w porównaniu do lat na których klasyfikator był uczony.
Z eksperymentu widać, że zaproponowana metoda uczenia modelu znajdowania wzorców we wskaźnikach analizy technicznej zapowiada się obiecująco i w dalszych pracach można skupić się na dostrojeniu parametrów modelu oraz poszerzyć wachlarz dostępnych wskaźników. Zastanowić się również można nad dokładniejszym oznaczeniu miejsc kupna i sprzedaży.
Na tej wizualizacji widać przeuczenie modelu, które z uwagi na brak czasu nie zostało poprawione.